; queens.ss  --  Jens Axel Soegaard  -- 18th may 2003

(require "../heap.ss")

; THE PUZZLE

; Place 8 queens on a chess board, so that no queen
; can beat another. No pair of queens are on the
; same row, column or diagonal.

; This arrangement of queens

; row           p
;  0 *--------  0
;  1 ---*-----  3
;  2 -*-------  1
;  3 ----*----  4
;  4 ---------
;  5 ---------
;  6 ---------
;  7 ---------

; A configuration c is represented c = (4 1 3 0).
; The first empty row is (length c) = 5

; Predicate 
;  (peace? c p) :  A queen in position p in row (length c) is
;                  not in conflict with any queen in c.

(define (peace? c p)
  (and (not (member p c))  ; column
       (let loop ([c c]
                  [nw (- p 1)]  ; position of north-west diagonal above 
                  [ne (+ p 1)]) ; position of north-east diagonal above
         (or (empty? c)
             (and (not (= (car c) nw))
                  (not (= (car c) ne))
                  (loop (cdr c) (- nw 1) (+ ne 1)))))))

; We search the longest configurations first.

(define lists-ordered-by-length@
  (predicates->ordered
   (lambda (l1 l2) (=  (length l1) (length l2)))
   (lambda (l1 l2) (>  (length l1) (length l2)))
   (lambda (l1 l2) (>= (length l1) (length l2)))))

; We choose the  
; (use-heap (bootstrap-heap skew-binomial-heap@ lists-ordered-by-length@))
; (use-heap (instantiate-heap skew-binomial-heap@ lists-ordered-by-length@))
(use-heap (instantiate-heap skew-binomial-heap@ lists-ordered-by-length@))


; insert* : PQ list -> PQ
;  insert all elements of the list l into the priority queue
(define (insert* pq l)
  (if (null? l)
      pq
      (insert* (insert pq (car l)) (cdr l))))

; interval : integer integer -> (list integer)
;  (interval m n) = (list m m+1 ... n)
(define (interval m n)
  (if (> m n)
      '()
      (cons m (interval (+ m 1) n))))

; queens : integer -> configuration or 'no-solution
;  find a configuration of queens that solve the n-queen problem
(define (queens n)
  (define (search pq)
    (if (empty? pq)
        'no-solution  
        (let* ([c  (find-min pq)]
               [PQ (delete-min pq)])
          (if (= (length c) n)
              c       
              (search (insert* PQ 
                               (map (lambda (p) (cons p c))
                                    (filter (lambda (p) (peace? c p))
                                            (interval 0 (- n 1))))))))))
  (search (insert '() empty)))

; (queens 4) = ...
; (queens 8) = ...

(queens 8)
